home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / e33el2.zip / emacs / 19.33 / lisp / profile.el < prev    next >
Lisp/Scheme  |  1996-07-02  |  13KB  |  316 lines
  1. ;;; profile.el --- generate run time measurements of Emacs Lisp functions
  2.  
  3. ;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Boaz Ben-Zvi <boaz@lcs.mit.edu>
  6. ;; Created: 07 Feb 1992
  7. ;; Version: 1.0
  8. ;; Adapted-By: ESR
  9. ;; Keywords: lisp, tools
  10.  
  11. ;; This file is part of GNU Emacs.
  12.  
  13. ;; GNU Emacs is free software; you can redistribute it and/or modify
  14. ;; it under the terms of the GNU General Public License as published by
  15. ;; the Free Software Foundation; either version 2, or (at your option)
  16. ;; any later version.
  17.  
  18. ;; GNU Emacs is distributed in the hope that it will be useful,
  19. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. ;; GNU General Public License for more details.
  22.  
  23. ;; You should have received a copy of the GNU General Public License
  24. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26. ;; Boston, MA 02111-1307, USA.
  27.  
  28. ;;; Commentary:
  29.  
  30. ;; DESCRIPTION:
  31. ;; ------------
  32. ;;   This program can be used to monitor running time performance of Emacs Lisp
  33. ;; functions. It takes a list of functions and report the real time spent 
  34. ;; inside these functions. It runs a process with a separate timer program.
  35. ;;   Caveat: the C code in ../lib-src/profile.c requires BSD-compatible
  36. ;; time-of-day functions.  If you're running an AT&T version prior to SVr4,
  37. ;; you may have difficulty getting it to work.  Your X library may supply
  38. ;; the required routines if the standard C library does not.
  39.  
  40. ;; HOW TO USE:
  41. ;; -----------
  42. ;;   Set the variable  profile-functions-list  to the list of functions
  43. ;; (as symbols) You want to profile. Call  M-x  profile-functions to set 
  44. ;; this list on and start using your program.  Note that profile-functions 
  45. ;; MUST be called AFTER all the functions in profile-functions-list have 
  46. ;; been loaded !!   (This call modifies the code of the profiled functions.
  47. ;; Hence if you reload these functions, you need to call  profile-functions  
  48. ;; again! ).
  49. ;;   To display the results do  M-x  profile-results .  For example:
  50. ;;-------------------------------------------------------------------
  51. ;;  (setq profile-functions-list '(sokoban-set-mode-line sokoban-load-game 
  52. ;;                              sokoban-move-vertical sokoban-move))
  53. ;;  (load "sokoban")
  54. ;;  M-x profile-functions
  55. ;;     ...  I play the sokoban game ..........
  56. ;;  M-x profile-results
  57. ;;
  58. ;;      Function                     Time (Seconds.Useconds)
  59. ;;      ========                     =======================
  60. ;;      sokoban-move                     0.539088
  61. ;;      sokoban-move-vertical            0.410130
  62. ;;      sokoban-load-game                0.453235
  63. ;;      sokoban-set-mode-line            1.949203
  64. ;;-----------------------------------------------------
  65. ;; To clear all the settings to profile use profile-finish. 
  66. ;; To set one function at a time (instead of or in addition to setting the 
  67. ;; above list and  M-x profile-functions) use M-x profile-a-function.
  68.  
  69. ;;; Code:
  70.  
  71. ;;;
  72. ;;;  User modifiable VARIABLES
  73. ;;;
  74.  
  75. (defvar profile-functions-list nil "*List of functions to profile.")
  76. (defvar profile-timer-program
  77.   (concat exec-directory "profile")
  78.   "*Name of the profile timer program.")
  79.  
  80. ;;;
  81. ;;; V A R I A B L E S
  82. ;;;
  83.  
  84. (defvar profile-timer-process nil "Process running the timer.")
  85. (defvar profile-time-list nil 
  86.     "List of cumulative calls and time for each profiled function.")
  87. (defvar profile-init-list nil
  88.     "List of entry time for each function. \n\
  89. Both how many times invoked and real time of start.")
  90. (defvar profile-max-fun-name 0 "Max length of name of any function profiled.")
  91. (defvar profile-temp-result- nil "Should NOT be used anywhere else.")
  92. (defvar profile-time (cons 0 0) "Used to return result from a filter.")
  93. (defvar profile-buffer "*profile*" "Name of profile buffer.")
  94.  
  95. ;;;
  96. ;;; F U N C T I O N S
  97. ;;;
  98.  
  99. (defun profile-functions (&optional flist)
  100.   "Profile all the functions listed in `profile-functions-list'.\n\
  101. With argument FLIST, use the list FLIST instead."
  102.   (interactive "P")
  103.   (if (null flist) (setq flist profile-functions-list))
  104.   (mapcar 'profile-a-function flist))
  105.  
  106. (defun profile-filter (process input)
  107.   "Filter for the timer process.  Sets `profile-time' to the returned time."
  108.   (if (zerop (string-match "\\." input)) 
  109.       (error "Bad output from %s" profile-timer-program)
  110.     (setcar profile-time 
  111.         (string-to-int (substring input 0 (match-beginning 0))))
  112.     (setcdr profile-time 
  113.         (string-to-int (substring input (match-end 0))))))
  114.  
  115.  
  116. (defun profile-print (entry)
  117.   "Print one ENTRY (from `profile-time-list')."
  118.   (let* ((calls (car (cdr entry)))
  119.      (timec (cdr (cdr entry)))
  120.      (time (+ (car timec) (/ (cdr timec) (float profile-million))))
  121.      (avgtime 0.0))
  122.     (insert (format (concat "%-"
  123.                 (int-to-string profile-max-fun-name)
  124.                 "s%8d%11d.%06d")
  125.             (car entry) calls (car timec) (cdr timec))
  126.         (if (zerop calls)
  127.         "\n"
  128.           (format "%12d.%06d\n"
  129.               (truncate (setq avgtime (/ time calls)))
  130.               (truncate (* (- avgtime (ftruncate avgtime))
  131.                    profile-million))))
  132.         )))
  133.  
  134. (defun profile-results ()
  135.   "Display profiling results in the buffer `*profile*'.
  136. \(The buffer name comes from `profile-buffer'.)"
  137.   (interactive)
  138.   (switch-to-buffer profile-buffer)
  139.   (erase-buffer)
  140.   (insert "Function" (make-string (- profile-max-fun-name 6) ? ))
  141.   (insert " Calls  Total time (sec)  Avg time per call\n")
  142.   (insert (make-string profile-max-fun-name ?=) "  ")
  143.   (insert "======  ================  =================\n")
  144.   (mapcar 'profile-print profile-time-list))
  145.     
  146. (defun profile-reset-timer ()
  147.   (process-send-string profile-timer-process "z\n"))
  148.  
  149. (defun profile-check-zero-init-times (entry)
  150.   "If ENTRY has non zero time, give an error."
  151.   (let ((time (cdr (cdr entry))))
  152.     (if (and (zerop (car time)) (zerop (cdr time))) nil ; OK
  153.       (error "Process timer died while making performance profile."))))
  154.  
  155. (defun profile-get-time ()
  156.   "Get time from timer process into `profile-time'."
  157.   ;; first time or if process dies
  158.   (if (and (processp profile-timer-process)
  159.        (eq 'run (process-status profile-timer-process))) nil
  160.     (setq profile-timer-process;; [re]start the timer process
  161.       (start-process "timer" 
  162.              (get-buffer-create profile-buffer) 
  163.              profile-timer-program))
  164.     (set-process-filter profile-timer-process 'profile-filter)
  165.     (process-kill-without-query profile-timer-process)
  166.     (profile-reset-timer)
  167.     ;; check if timer died during time measurement
  168.     (mapcar 'profile-check-zero-init-times profile-init-list)) 
  169.   ;; make timer process return current time
  170.   (process-send-string profile-timer-process "p\n")
  171.   (accept-process-output))
  172.  
  173. (defun profile-find-function (fun flist)
  174.   "Linear search for FUN in FLIST."
  175.   (if (null flist) nil
  176.     (if (eq fun (car (car flist))) (cdr (car flist))
  177.       (profile-find-function fun (cdr flist)))))
  178.  
  179. (defun profile-start-function (fun)
  180.   "On entry, keep current time for function FUN."
  181.   ;; assumes that profile-time contains the current time
  182.   (let ((init-time (profile-find-function fun profile-init-list)))
  183.     (if (null init-time) (error "Function %s missing from list" fun))
  184.     (if (not (zerop (car init-time)));; is it a recursive call ?
  185.     (setcar init-time (1+ (car init-time)))
  186.       (setcar init-time 1)        ; mark first entry
  187.       (setq init-time (cdr init-time))
  188.       (setcar init-time (car profile-time))
  189.       (setcdr init-time (cdr profile-time)))
  190.     ))
  191.     
  192. (defconst profile-million 1000000)
  193.  
  194. (defun profile-update-function (fun)
  195.   "When the call to the function FUN is finished, add its run time."
  196.   ;; assumes that profile-time contains the current time
  197.   (let ((init-time (profile-find-function fun profile-init-list))
  198.     (accum (profile-find-function fun profile-time-list))
  199.     calls time sec usec)
  200.     (if (or (null init-time)
  201.         (null accum)) (error "Function %s missing from list" fun))
  202.     (setq calls (car accum))
  203.     (s